(SETQ IBASE (ADD1 7)) 


(DEFPROP ALLFNS 
 (NIL FIXVEC2
      TEST3
      TEST2
      BLOCK
      NTH
      CYMBAL
      MAPORCAR
      WINDOW-IN-OPPOSITE-HALF-PLANE?
      ANGLE
      PI
      ZUM
      D
      SETUP
      RE
      ARD
      TEST1
      PERSPECT
      PAN
      TILT
      ZOOM
      XEROX
      YOYO
      ZEBRA
      SAFE
      PLOTTER
      IVP
      VIP) 
VALUE)

(DEFPROP FIXVEC2 
 (LAMBDA(V)
  (CONS (CONS (FIX (TIMES FACTOR (CAAR V))) (FIX (TIMES FACTOR (CDAR V))))
	(CONS (FIX (TIMES FACTOR (CADR V))) (FIX (TIMES FACTOR (CDDR V)))))) 
EXPR)

(DEFPROP TEST3 
 (LAMBDA NIL (TEST2 (APPEND BL1 BL2 BL3))) 
EXPR)

(DEFPROP TEST2 
 (LAMBDA(ZILCH)
  (PROG NIL
	(MAPC (FUNCTION (LAMBDA (ZAP) (MAPC (FUNCTION PERSPECT) (GET ZAP (QUOTE CORNERS))))) ZILCH)
	(MAPC (FUNCTION (LAMBDA (ZAP) (HIDDEN-LINE VIEWNAME (LIST ZAP)))) ZILCH)
	(CLEAR)
	(MAPC (FUNCTION III) ZILCH))) 
EXPR)

(DEFPROP BLOCK 
 (LAMBDA(X Y Z)
  (PROG (V F E)
	(SETQ V (CYMBAL 10))
	(SETQ F (CYMBAL 6))
	(SETQ E (CYMBAL 14))
	(SET (NTH 1 V) (LIST X Y (MINUS Z)))
	(SET (NTH 2 V) (LIST X Y Z))
	(SET (NTH 3 V) (LIST X (MINUS Y) Z))
	(SET (NTH 4 V) (LIST X (MINUS Y) (MINUS Z)))
	(SET (NTH 5 V) (LIST (MINUS X) Y (MINUS Z)))
	(SET (NTH 6 V) (LIST (MINUS X) Y Z))
	(SET (NTH 7 V) (LIST (MINUS X) (MINUS Y) Z))
	(SET (NTH 10 V) (LIST (MINUS X) (MINUS Y) (MINUS Z)))
	(PUTPROP (NTH 1 E) (CONS (NTH 3 V) (NTH 4 V)) (QUOTE POINTS))
	(PUTPROP (NTH 2 E) (CONS (NTH 3 V) (NTH 2 V)) (QUOTE POINTS))
	(PUTPROP (NTH 3 E) (CONS (NTH 1 V) (NTH 2 V)) (QUOTE POINTS))
	(PUTPROP (NTH 4 E) (CONS (NTH 1 V) (NTH 4 V)) (QUOTE POINTS))
	(PUTPROP (NTH 5 E) (CONS (NTH 4 V) (NTH 10 V)) (QUOTE POINTS))
	(PUTPROP (NTH 6 E) (CONS (NTH 3 V) (NTH 7 V)) (QUOTE POINTS))
	(PUTPROP (NTH 7 E) (CONS (NTH 2 V) (NTH 6 V)) (QUOTE POINTS))
	(PUTPROP (NTH 10 E) (CONS (NTH 1 V) (NTH 5 V)) (QUOTE POINTS))
	(PUTPROP (NTH 11 E) (CONS (NTH 5 V) (NTH 10 V)) (QUOTE POINTS))
	(PUTPROP (NTH 12 E) (CONS (NTH 7 V) (NTH 10 V)) (QUOTE POINTS))
	(PUTPROP (NTH 13 E) (CONS (NTH 6 V) (NTH 7 V)) (QUOTE POINTS))
	(PUTPROP (NTH 14 E) (CONS (NTH 5 V) (NTH 6 V)) (QUOTE POINTS))
	(PUTPROP (NTH 1 F) (LIST (NTH 5 V) (NTH 6 V) (NTH 7 V) (NTH 10 V)) (QUOTE CORNERS))
	(PUTPROP (NTH 2 F) (LIST (NTH 3 V) (NTH 4 V) (NTH 10 V) (NTH 7 V)) (QUOTE CORNERS))
	(PUTPROP (NTH 3 F) (LIST (NTH 1 V) (NTH 2 V) (NTH 3 V) (NTH 4 V)) (QUOTE CORNERS))
	(PUTPROP (NTH 4 F) (LIST (NTH 1 V) (NTH 4 V) (NTH 10 V) (NTH 5 V)) (QUOTE CORNERS))
	(PUTPROP (NTH 5 F) (LIST (NTH 1 V) (NTH 2 V) (NTH 6 V) (NTH 5 V)) (QUOTE CORNERS))
	(PUTPROP (NTH 6 F) (LIST (NTH 2 V) (NTH 3 V) (NTH 7 V) (NTH 6 V)) (QUOTE CORNERS))
	(PUTPROP (NTH 1 F) (LIST (NTH 11 E) (NTH 12 E) (NTH 13 E) (NTH 14 E)) (QUOTE EDGES))
	(PUTPROP (NTH 2 F) (LIST (NTH 1 E) (NTH 5 E) (NTH 12 E) (NTH 6 E)) (QUOTE EDGES))
	(PUTPROP (NTH 3 F) (LIST (NTH 1 E) (NTH 2 E) (NTH 3 E) (NTH 4 E)) (QUOTE EDGES))
	(PUTPROP (NTH 4 F) (LIST (NTH 4 E) (NTH 5 E) (NTH 11 E) (NTH 10 E)) (QUOTE EDGES))
	(PUTPROP (NTH 5 F) (LIST (NTH 3 E) (NTH 10 E) (NTH 14 E) (NTH 7 E)) (QUOTE EDGES))
	(PUTPROP (NTH 6 F) (LIST (NTH 2 E) (NTH 6 E) (NTH 13 E) (NTH 7 E)) (QUOTE EDGES))
	(RETURN F))) 
EXPR)

(DEFPROP NTH 
 (LAMBDA (N L) (COND ((EQ 1 N) (CAR L)) (T (NTH (SUB1 N) (CDR L))))) 
EXPR)

(DEFPROP CYMBAL 
 (LAMBDA (N) (COND ((ZEROP N) NIL) (T (CONS (INTERN (GENSYM)) (CYMBAL (SUB1 N)))))) 
EXPR)

(DEFPROP MAPORCAR 
 (LAMBDA (FN L) (COND ((NULL L) NIL) ((FN (CAR L)) T) (T (MAPORCAR FN (CDR L))))) 
EXPR)

(DEFPROP WINDOW-IN-OPPOSITE-HALF-PLANE? 
 (LAMBDA(EDGE)
  (PROG (SIGN EDG X Y)
	(SETQ X (GET EDGE (QUOTE ENDS)))
	(SETQ EDG (LIST (LIST (CAAR X) (CDAR X)) (LIST (CADR X) (CDDR X))))
	(SETQ X
	      (DELETE (CAR (GET EDGE (QUOTE POINTS)))
		      (DELETE (CDR (GET EDGE (QUOTE POINTS))) (GET POLYGON (QUOTE CORNERS)))))
	(SETQ X (GET (CAR X) (QUOTE IMAGE)))
	(SETQ Y (CADR X))
	(SETQ X (CAR X))
	(SETQ SIGN (MMMM X Y EDG))
	(RETURN
	 (AND (MINUSP (TIMES SIGN (MMMM XLOW YLOW EDG)))
	      (MINUSP (TIMES SIGN (MMMM XLOW YHIGH EDG)))
	      (MINUSP (TIMES SIGN (MMMM XHIGH YLOW EDG)))
	      (MINUSP (TIMES SIGN (MMMM XHIGH YHIGH EDG))))))) 
EXPR)

(DEFPROP ANGLE 
 (LAMBDA NIL (QUOTIENT (TIMES 360.0 (ARCTAN (QUOTIENT ZOOM (TIMES 2.0 D)))) PI)) 
EXPR)

(DEFPROP PI 
 (NIL . 3.1415925) 
VALUE)

(DEFPROP ZUM 
 (NIL . 0.5) 
VALUE)

(DEFPROP D 
 (NIL . 1400) 
VALUE)

(DEFPROP SETUP 
 (LAMBDA NIL
  (PROG NIL
	(DATA)
	(MAPC (FUNCTION VIP) (APPEND (GET (QUOTE RR1) (QUOTE CORNERS)) (GET (QUOTE RR2) (QUOTE CORNERS)))))) 
EXPR)

(DEFPROP RE 
 (LAMBDA NIL (ARD VIEWNAME)) 
EXPR)

(DEFPROP ARD 
 (LAMBDA(VV)
  (PROG NIL (SETQ VIEWNAME VV) (LINELENGTH 37777) (ARDS (QUOTE RR1)) (ARDS (QUOTE RR2)) (LINELENGTH 105))) 
EXPR)

(DEFPROP TEST1 
 (LAMBDA NIL
  (PROG NIL
	(MAPC (FUNCTION PERSPECT) (APPEND (GET (QUOTE RR1) (QUOTE CORNERS)) (GET (QUOTE RR2) (QUOTE CORNERS))))
	(HIDDEN-LINE VIEWNAME (QUOTE (RR1)))
	(HIDDEN-LINE VIEWNAME (QUOTE (RR2)))
	(LINELENGTH 37777)
	(CLEAR)
	(III (QUOTE RR1))
	(III (QUOTE RR2))
	(LINELENGTH 105))) 
EXPR)

(DEFPROP PERSPECT 
 (LAMBDA(POINT)
  (PROG (XX XXX YY YYY YYYY ZZ ZZZ)
	(SETQ ZZ (EVAL POINT))
	(SETQ XX (CAR ZZ))
	(SETQ YY (CADR ZZ))
	(SETQ ZZ (CADDR ZZ))
	(SETQ XX (DIFFERENCE XX XEROX))
	(SETQ YY (DIFFERENCE YY YOYO))
	(SETQ ZZ (DIFFERENCE ZZ ZEBRA))
	(SETQ XXX (PLUS (TIMES XX (COSINE PAN)) (TIMES YY (SINE PAN))))
	(SETQ YYY (DIFFERENCE (TIMES YY (COSINE PAN)) (TIMES XX (SINE PAN))))
	(SETQ YYYY (PLUS (TIMES YYY (COSINE TILT)) (TIMES ZZ (SINE TILT))))
	(SETQ ZZZ (DIFFERENCE (TIMES ZZ (COSINE TILT)) (TIMES YYY (SINE TILT))))
	(PUTPROP POINT
		 (LIST (QUOTIENT (TIMES D ZUM XXX) (DIFFERENCE D ZZZ))
		       (QUOTIENT (TIMES D ZUM YYYY) (DIFFERENCE D ZZZ))
 		       ZZZ)
		 (QUOTE IMAGE)))) 
EXPR)

(DEFPROP PAN 
 (NIL . 0.0) 
VALUE)

(DEFPROP TILT 
 (NIL . 3.1415925) 
VALUE)

(DEFPROP ZOOM 
 (NIL . 4000) 
VALUE)

(DEFPROP XEROX 
 (NIL . -2000) 
VALUE)

(DEFPROP YOYO 
 (NIL . -2000) 
VALUE)

(DEFPROP ZEBRA 
 (NIL . -2000) 
VALUE)

(DEFPROP SAFE 
 (LAMBDA NIL (DSKOUT HIDE3 (GRINL ALLFNS))) 
EXPR)

(DEFPROP PLOTTER 
 (LAMBDA NIL
  (PROG NIL
	(OUTPUT PTP:)
	(OUTC T T)
	(LINELENGTH 37777)
	(MAPC (FUNCTION PLOT) (APPEND BL1 BL2 BL3))
	(OUTC NIL T))) 
EXPR)

(DEFPROP IVP 
 (LAMBDA (Z) (PUTPROP Z (GET Z (QUOTE VALUE)) (QUOTE IMAGE))) 
EXPR)

(DEFPROP VIP 
 (LAMBDA (Z) (SET Z (GET Z (QUOTE IMAGE)))) 
EXPR)